home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / makebin.com / BINIPC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-04-16  |  6.7 KB  |  158 lines
  1. {Binary file Interprocess Communications unit}
  2. {BINIPC  V1.01  Copyright 1989  Michael Day   as of 16 April 1989}
  3. {all rights reserved}
  4.  
  5. {The IPC allows you to communicate with the calling program.}
  6. {this is accomplished through a section of memory which is allocated}
  7. {below the BIN program's PSP segment to contain the register information}
  8. {that was passed to the BIN program, and to allow the BIN program to}
  9. {pass it's own register values back to the caller.}
  10. {Access to several additional support variables is also provided}
  11. {most notably, the Entry address into the BIN program which allows}
  12. {it to be changed for subsequent re-entry into the program.}
  13. {(You must declare any alternate entry as FAR)}
  14.  
  15. unit BinIpc;
  16. interface
  17.  
  18. type BinEntry = pointer;  {entry address of BIN file}
  19.      PrcType = procedure; {procedure pointer type}
  20.  
  21.      {Inter Process Communication format}
  22.      IPCrecType = record
  23.          {BIPC contains 'BIPC' if the program has been properly loaded.}
  24.        BIPC    : array[0..3] of char;  {validty check variable}
  25.  
  26.          {The following variables contain the caller's register values}
  27.          {these can be used to pass information between the caller and}
  28.          {the loaded BIN program. These registers are then returned to}
  29.          {the caller upon exit. Be careful about changing the registers}
  30.          {since most programs expect certain registers to remain intact.}
  31.          {Dbase expects DS,SS,SP to remain unchanged. Others also expect}
  32.          {BP to remain unchanged. Some expect all of them to remain intact.}
  33.        OldFlgs : word;  {flags on entry to the BIN file}
  34.        OldAX   : word;  {AX register on entry to the BIN file}
  35.        OldBX   : word;  {BX register on entry to the BIN file}
  36.        OldCX   : word;  {CX register on entry to the BIN file}
  37.        OldDX   : word;  {DX register on entry to the BIN file}
  38.        OldSI   : word;  {SI register on entry to the BIN file}
  39.        OldDI   : word;  {DI register on entry to the BIN file}
  40.        OldDS   : word;  {DS register on entry to the BIN file}
  41.        OldES   : word;  {ES register on entry to the BIN file}
  42.        OldBP   : word;  {BP register on entry to the BIN file}
  43.        OldStk  : pointer;  {SS:SP registers, stack on entry to the BIN file}
  44.  
  45.          {You can change work pointer to cause the next entry into the BIN}
  46.          {program to occur at a different address. This will cause a warm}
  47.          {entry which means that the PSP will not be rebuilt, and the last}
  48.          {internal stack address is used. If WrkPtr = LoadPtr, then the PSP}
  49.          {is completely rebuilt, and the stack is set to the original entry}
  50.          {location found in the EXE header. If you wish the BIN program to}
  51.          {use the caller's stack, set WrkStk to nil (0). Setting it to}
  52.          {LoadStk will return it to the BIN program's stack area.}
  53.        WrkPtr  : BinEntry; {CS:IP, pointer to current Entry address of BIN}
  54.        WrkStk  : pointer;  {stack on exit from BIN file}
  55.  
  56.          {The following varibles are provided for reference only,}
  57.          {they are not to be changed, or odd things may happen.}
  58.        BinDS   : word;      {DS seg on exit from BIN file}
  59.        BinSS   : word;      {SS seg on exit from BIN file}
  60.        LoadPtr : pointer;   {original entry point of BIN file}
  61.        LoadStk : pointer;   {original stack location of BIN file}
  62.        PspSeg  : word;      {current PSP seg of BIN file}
  63.        OldPsp  : word;      {caller's PSP segment}
  64.        PrgSiz  : word;      {Total size of bin file in paragraphs}
  65.      end;
  66.  
  67.   {Once the BIN program is running, IPC will point to the IPC structure}
  68. var IPC : ^IPCrecType;  {IPC points to the IPC record}
  69.  
  70. {----------------------------------------------------------------------}
  71.  
  72. function GetDbString(var S:string):boolean;
  73. function SetDbString(var S:string):boolean;
  74. procedure BinLoadCheck;
  75. procedure SetBinEntry(Prc:PrcType);
  76.  
  77.  
  78. { ******************************************************************** }
  79. implementation
  80.  
  81. {-----------------------------------------------------------------------}
  82. {Read the Dbase string that was passed. If no string passed, returns}
  83. {false and a null string. If string passed, returns true and the string.}
  84. function GetDbString(var S:string):boolean;
  85. type DbsType = array[0..255] of char;
  86. var  DbsPtr : ^DbsType;
  87.      i : integer;
  88. begin
  89.   GetDbString := false;
  90.   S := '';
  91.   if IPC = nil then Exit;
  92.   DbsPtr := pointer((longint(IPC^.OldDS) shl 16) + IPC^.OldBX);
  93.   if DbsPtr = nil then Exit;  {if ptr = 0 then no var passed}
  94.   i := 0;
  95.   while DbsPtr^[i] <> #0 do
  96.   begin
  97.     S[succ(i)] := DbsPtr^[i];
  98.     inc(i);
  99.   end;
  100.   S[0] := char(i);
  101.   GetDbString := true;
  102. end;
  103.  
  104. {---------------------------------------------------------------------}
  105. {Write to a Dbase string that was passed. If no string passed, returns}
  106. {false and no change is attempted. If a string was passed, returns true}
  107. {and the string is changed. (Note: the string lengths *must* match, or}
  108. {Dbase will get upset. This function will return false if no string was}
  109. {passed, Otherwise it returns true. It will only copy a string upto the}
  110. {length of the string, or the size of the Dbase string. If the Dbase}
  111. {string length was zero, then nothing is copied, but no error is given.}
  112. function SetDbString(var S:string):boolean;
  113. type DbsType = array[0..255] of char;
  114. var  DbsPtr : ^DbsType;
  115.      i : integer;
  116. begin
  117.   SetDbString := false;
  118.   if IPC = nil then Exit;
  119.   DbsPtr := pointer((longint(IPC^.OldDS) shl 16) + IPC^.OldBX);
  120.   if DbsPtr = nil then Exit;  {if DS:BX is nil, then no pointer was passed}
  121.   i := 0;
  122.   while (DbsPtr^[i] <> #0) and (i <= length(S)) do
  123.   begin
  124.     DbsPtr^[i] := S[succ(i)];
  125.     inc(i);
  126.   end;
  127.   SetDbString := true;
  128. end;
  129.  
  130. procedure SetBinEntry(Prc:PrcType);
  131. begin
  132.   PrcType(IPC^.WrkPtr) := Prc;
  133. end;
  134.  
  135. {----------------------------------------------------------------------}
  136. {check for load error, if bad, output an error message and stop program}
  137. procedure TtyChar(Ch:char; Color:byte);
  138.   inline($55/$B4/$0F/$CD/$10/$5D/$58/$88/$C3/$58/$55/$B4/$0E/$CD/$10/$5D);
  139.   {push bp, mov ah,$f, int $10, pop bp, pop ax, mov bl,al, pop ax,}
  140.   {push bp, mov ah,$e, int $10, pop bp}
  141. procedure BinLoadCheck;
  142. var i : integer;
  143.     S : string[80];
  144. begin
  145.    if IPC <> nil then Exit;
  146.    S := #10+#13+'** Error: BIN IPC damaged - Program aborted **'+#10+#13;
  147.    for i := 1 to length(S) do
  148.      TtyChar(S[i],15);
  149.    Halt;
  150. end;
  151.  
  152. { ********************************************************* }
  153. {initialize IPC pointer, and check if valid}
  154. begin
  155.   IPC := pointer(pointer((longint(PrefixSeg)-2) shl 16)^);
  156.   if (IPC^.BIPC <> 'BIPC') then IPC := nil; {nil = invalid interface record}
  157. end.
  158.